C---- PROGRAM ID  29/10/80
      COMPILER(1)=100H
      COMPILER(3)=26FFH


      SUBROUTINE RANDOM(SEED)

C---- ROUTINE TO RETURN A 16-BIT RANDOM NUMBER GIVEN
C     A SEED. USES THE ADDITIVE CONGRUENTIAL METHOD.

      INTEGER*2 SEED

C---- NEW NUMBER IS GENERATED FROM THE FORMULA:-
C     NEW=SEED*(2**11+2**2+1)+33031Q
C
C---- THE ACTUAL CODE IS:-
C     LHLD SEED ; MOV  C,L  ; MOV  B,H  ; MOV  H,L  ;
C     MVI  L,0  ; DAD  H    ; DAD  B    ; DAD  H    ;
C     DAD  H    ; DAD  B    ; LXI B,33031Q 
C     DAD  B    ; SHLD SEED ;

      INLINE/2AH,ADDRESS(SEED),4DH,44H,65H,2EH,00H/
      INLINE/29H,09H,29H,29H,09H,01H,19H,36H/
      INLINE/09H,22H,ADDRESS(SEED)/

      RETURN
      END

      INTEGER*2 FUNCTION RAND0
      INTEGER*2 ISEED
100   CALL RANDOM(ISEED)
      RAND0=ISEED.AND.0FFFH
      RETURN
      END

      INTEGER*2 FUNCTION MOD(I,J)
      INTEGER*2 I,J
      MOD=I-I/J*J
      RETURN
      END

      REAL*8 FUNCTION AMOD(A,B)
      REAL*8 A,B,C
      C=A
200   IF(C.LT.B)GO TO 100
      C=C-B
      GO TO 200
100   AMOD=C
      RETURN
      END

      INTEGER*1 KMERC,NX,IWA
      INTEGER*1 INAME(16)


1     WRITE(1,1001)
1001  FORMAT(//' THIS IS THE KINGDOM OF ID'/
     1 ' YOU HAVE BEEN CALLED BEFORE THE KING!'//
     2 ' WHAT IS YOUR NAME?....')
      READ(1)STRING(INAME,16)
      ICN=INAME(1)+INAME(2)+INAME(3)
      DO 999 I = 1,ICN
999   J=RAND0

C---- CONSTANTS USED IN THIS PROGRAM.

      LAZY=0
      NOFEED=0
      IAFFC=100
      IWARN=0
      IWA=.FALSE.
      IWMAX=25
      IWLIM=20
      MERC=0
      IMERC=80
      IBTHS=0
      IDTHS=0
      PLANT=0.0
      YIELD=5.0
      WHEAT=5.001
      IPUT=9
      NBTHS=7
      NDTHS=14
      JMERC=11
      LMERC=5
      AMERC=0.3
      KMERC=.FALSE.
      PLAGE=0.7
      RRATE=60.0
      REATR=0.06
      WEEVILS=0.4
      RANRATE=0.13
      STARVE=20.0
      NSTRV=0
      IPPLG=0
      WEAT=0.0
      IREAT=0
      ACRAT=7.0
      ACBUY=7.0
      PLSTK=0.7
      NMIN=21
      IYR=1
      GRAIN=5000.1
      ACRES=1500.1
      IPOP=100

C---- START OF PASS.
C---- DOES THE VICTIM DESERVE TO CONTINUE?

2       IF(IWARN-IWMAX)22,22,510

C---- GIVE ALL THE YEAR'S INPUT PARAMETERS.
22    FLOAT=IPOP
      IAFFL=(ACRES+GRAIN/25.0)/17.0*100.0/FLOAT
      IAFFC=IAFFL-IAFFC
      WRITE(1,115)(INAME(I),I=1,16),IYR,IAFFL,IAFFC
115     FORMAT(//2X,16A1/' YEAR',I4,'    AFFLUENCE RATIO',
     1  I5,'%    CHANGE',I5,'%')
      IAFFC=IAFFL

C---- MAYBE THE USER NEEDS A WARNING.

      IF(IWA)GO TO 51
      IF(IWARN-IWLIM)51,52,52
52      IWA=.TRUE.
      WRITE(1,1002)
1002  FORMAT(' YOUR MANAGEMENT DISPLEASES THE KING.'/
     1 ' YOU WILL BE IN BIG TROUBLE IF YOU DO NOT IMPROVE.')
51      IF(MERC)53,31,53
53      IPOPA=IBTHS*3/2
      IBTHS=IBTHS+IPOPA
      IPOP=IPOP+IPOPA
      WRITE(1,1003)
1003  FORMAT(' THE MERCENARIES YOU HIRED RAPED THE WOMEN,'/
     1 ' RESULTING IN AN ABNORMALLY HIGH BIRTH RATE.')
31      ICN=ACRES
      WRITE(1,101)IPOP,ICN,GRAIN
101     FORMAT(' THE KINGDOM HAS',I5,' PEASANTS',I6,' ACRES AND',
     1  F8.0,' BUSHELLS.')
      IF(IYR-1)57,54,57
54      WRITE(1,123)
123     FORMAT(' YOU ARE HEREBY COMMANDED BY HIS MAJESTY,',
     1 ' THE FINK, TO'/
     2  ' IMPROVE THE KINGDOMS ASSETS.'/
     3 ' GOOD LUCK (YOU WILL NEED IT) AND GOOD MANAGEMENT!'//)
57      IF(IYR-1)58,59,58
58      WRITE(1,122)IBTHS,IDTHS
122     FORMAT(' THERE WERE',I4,' BIRTHS &',I4,' NATURAL DEATHS.')
59      IF(NSTRV)61,61,60
60      WRITE(1,116)NSTRV
116     FORMAT(' STARVATION KILLED',I5,' PEASANTS.')
61      IF(IREAT)63,63,62
62      WRITE(1,114)IREAT
114     FORMAT(' THE RATS ATE',I5,' BUSHELLS.')
63      IF(WEAT)66,66,64
64      WRITE(1,111)WEAT
111     FORMAT(' THE WEEVILS RUINED',F7.0,' BUSHELLS.')
66      IF(IPPLG)68,68,67
67      WRITE(1,113)IPPLG
113     FORMAT(' THE PLAGUE & THE POX STRUCK',I4,' PEASANTS.')
68      IF(.NOT.KMERC)GO TO 26
      WRITE(1,1004)
1004  FORMAT(' THE HUNS LOOTED & PLUNDERED BECAUSE'/
     1 ' YOU DID NOT HIRE ENOUGH MERCENARIES!')
26      IF(PLANT-1.0)261,69,69
69      IF(YIELD-2.0)70,71,71
70      WRITE(1,1005)
1005  FORMAT(' A FAMINE HAS STRUCK! ')
71      WRITE(1,105)YIELD
105     FORMAT(' THE HARVEST YIELD WAS',F4.1,' BUSHELLS/ACRE.')

C---- SET UP PASS PARAMETERS.

261     NSTRV=0
      MERC=0
      KMERC=.FALSE.
      NX=.FALSE.
      BUSH=1.0E6
      WEAT=0.0
      IREAT=0
      IPPLG=0

C---- COMPUTE INITIAL BUY AND SELL RATES.

      NBUY=NMIN+MOD(RAND0,9)
      NSELL=NBUY-1

C---- DOES THE FELLA WANNA BUY?

3       WRITE(1,125)NBUY
125     FORMAT(' HOW MANY ACRES DO YOU WISH TO ',
     1 'BUY AT',I3,' BUSHELLS/ACRE? ')
      READ(1,ERR=3)ICN
      CRES=ICN
      IF(CRES)3,4,5
5     FLOAT=NBUY
      IF(FLOAT*CRES-GRAIN)55,55,72
72      IWARN=IWARN+1
      WRITE(1,104)
104     FORMAT(' THERE IS NOT ENOUGH GRAIN!')
      GO TO 3
55      IF(ACRES-ACBUY*CRES)73,73,56
73      IF(NX)GO TO 56

C---- HE TRIED TO BUY TOO MUCH. UP HIS PRICE.

      WRITE(1,1006)
1006  FORMAT(' SPECULATION INCREASES THE LAND PRICE!')
      IWARN=IWARN+1
      NBUY=NBUY+1
      NX=.TRUE.
      GO TO 3
56      ACRES=ACRES+CRES
      FLOAT=NBUY
      GRAIN=GRAIN-FLOAT*CRES
      GO TO 65

C---- DOES HE WANNA SELL?

4      WRITE(1,118)NSELL
118     FORMAT(' HOW MANY ACRES DO YOU WISH TO SELL AT',
     2 I3,' BUSHELLS/ACRE? ')
      READ(1,ERR=4)ICN
      CRES=ICN
      IF(ICN)4,65,7
7       IF(ACRES-ACRAT*CRES)74,74,8
74      IF(NX)GO TO 8

C---- THIS IS WHAT HAPPENS IF YOU TRY TO SELL TOO MUCH.

      NX=.TRUE.
      IWARN=IWARN+1
      WRITE(1,1007)
1007  FORMAT(' EXCESSIVE SELLING OF LAND LOWERS THE PRICE!')
      NSELL=NSELL-2
      GO TO 4
8       IF(CRES-ACRES)88,88,75
75      IWARN=IWARN+1
      WRITE(1,106)
106     FORMAT(' THE KINGDOM IS NOT THAT BIG!')
      GO TO 4
88      ACRES=ACRES-CRES
      FLOAT=NSELL
      GRAIN=GRAIN+FLOAT*CRES
65      NPLN=(RAND0/7).AND.3

C---- SEND THE PEASANTS TO WORK PLANTING THE FIELDS.

6     WRITE(1,1008)
1008  FORMAT(' HOW MANY ACRES DO YOU WISH TO PLANT? ')
      READ(1,ERR=6)ICN
      PLANT=ICN
      IF(ICN)6,212,616
616     IF(PLANT-ACRES)10,10,76
76      IWARN=IWARN+1
      WRITE(1,106)
      GO TO 6
10      IF(PLANT-GRAIN)11,77,77
77      IWARN=IWARN+1
      WRITE(1,104)
      GO TO 6
11      IF(ICN-IPOP*(IPUT+NPLN))112,78,78

C---- THEY CAN ONLY DO SO MUCH WORK!

78      WRITE(1,1009)
1009  FORMAT(' THAT IS OVERWORKING THE PEASANTS.')
      IWARN=IWARN+1
      GO TO 6
112     GRAIN=GRAIN-PLANT
      IF(LAZY-4)212,79,79
79      LAZY=0

C---- LAZINESS CAN REDUCE THE AMOUNT SOWN.

      PLANT=PLANT*PLSTK
      ICN=PLANT
      WRITE(1,119)ICN
119     FORMAT(' THE LAZY PEASANTS ONLY PLANTED',I5,' ACRES.')
212     IF(RAND0-31000)12,211,211

C---- SOMETIMES THE FIELDS NEED A BOOST. NOT ENOUGH WILL BE BAD.

211     IFERT=(RAND0.AND.3)+1
221   WRITE(1,120)IFERT
120     FORMAT(' HOW MANY BAGS OF FERTILIZER WILL WE BUY AT',I2,
     1  ' BUSHELLS EACH? ')
      READ(1,ERR=221)ICN
      BUSH=ICN*IFERT
      IF(BUSH-GRAIN)311,80,80
80      IWARN=IWARN+1
      WRITE(1,104)
      GO TO 211
311     GRAIN=GRAIN-BUSH

C---- FINALLY, THE PEASANTS MUST BE FED.

12      WRITE(1,1010)
1010  FORMAT(' HOW MANY BUSHELLS DO YOU WISH TO USE AS FOOD? ')
      READ(1,ERR=12)ICN
      GIVEN=ICN
      IF(ICN)12,13,13
13      IF(GIVEN-GRAIN)14,14,81
81      IWARN=IWARN+1
      WRITE(1,104)
      WRITE(1,1011)
1011  FORMAT(' THEY HAVE BEEN GIVEN ALL THAT REMAINS.')
      GIVEN=GRAIN
14      GRAIN=GRAIN-GIVEN
      FLOAT=RAND0.AND.0FFH
      USER=37.5+AMOD(FLOAT,3.0)
      IPOPA=GIVEN/USER
      IF(IPOPA-IPOP-3)83,83,82
82      LAZY=LAZY+1
83    IF(IAFFC-110)15,84,84
84      IF(RAND0-26000)15,85,85

C---- OCCASIONALLY THE HUNS ATTACK OUR LITTLE PARADISE.
C---- (ONLY IF IT IS WORTH WHILE.)

85      WRITE(1,1012)
1012  FORMAT(' THE HUNS THREATEN THE KINGDOM!!!')
      ICN=IMERC+MOD(NO.AND.0FFFH,7)
17      WRITE(1,121)ICN
121     FORMAT(' HOW MANY MERCENARIES WILL WE HIRE AT',I3,
     1  ' BUSHELLS EACH? ')
      READ(1,ERR=17)MERC
      FLOAT=MERC*ICN
      IF(FLOAT-GRAIN)16,16,86
86      IWARN=IWARN+1
      WRITE(1,104)
      GO TO 17
16      GRAIN=GRAIN-FLOAT
      IF(IPOP-MERC*JMERC)15,87,87

C---- NOT ENOUGH MERCENARIES MEANS LOOT & PLUNDER.

87      IWARN=IWARN+1
      KMERC=.TRUE.
      GRAIN=GRAIN*AMERC
      IPOP=IPOP/LMERC+2

C---- FIND OUT WHAT THIS YEAR'S YIELD WILL BE.

15    FLOAT=MOD(RAND0/7,4)
      YIELD=WHEAT+FLOAT

C---- A FAMINE CAN STRIKE ONCE EVERY 15 YEARS.

      IF(IYR-5)151,89,89
89      IF(RAND0-30000)151,151,90
90      YIELD=1.00001

C---- OR WE MAY NOT HAVE ADEQUATELY FERTILIZED.

151     IF(BUSH-PLANT/5.0)91,92,92
91      YIELD=YIELD/2.0
92      GRAIN=GRAIN+YIELD*PLANT

C---- HATCHED AND DISPATCHED SECTION.


C---- BIRTHS AND NATURAL DEATHS ARE RELATED TO THE AMOUNT
C---- OF GRAIN/PEASANT PROVIDED. STARVATION MAY KNOCK OUT
C---- MORE IF THERE IS INADEQUATE GRAIN.

      IBTHS=IPOPA/(NBTHS+(RAND0.AND.7))+2
      IDTHS=IPOPA/(NDTHS+(RAND0.AND.3))
      NSTRV=IPOP-IPOPA
      IF(NSTRV.LT.0)NSTRV=0
      IF(NSTRV)19,19,93
93      NOFEED=NOFEED+1
      IWARN=IWARN+1
      FLOAT=IPOP
      GLOAT=NSTRV
      IF(FLOAT-STARVE*GLOAT)94,95,95
94      IWARN=IWARN+4
95      IPOP=IPOPA
19      IYR=IYR+1
      IPOP=IPOP+IBTHS-IDTHS

C---- THE PLAGUE & THE POX WREAK HAVOC ON THE POPULATION.

      IF(RAND0-31000)20,96,96
96      IF(IPOP-25)20,97,97
97    FLOAT=IPOP
      IPPLG=FLOAT*PLAGE
      IPOP=IPOP-IPPLG
20      IF(RAND0-29000)21,98,98

C---- WHEN THE WEEVILS STRIKE, THEY REALLY STRIKE!

98      WEAT=GRAIN*WEEVILS
      GRAIN=GRAIN-WEAT
21    FLOAT=IPOP
      IF(GRAIN/FLOAT-RRATE)23,99,99
99      IF(RAND0-27000)23,40,40

C---- TOO MUCH SPARE GRAIN. THE RATS GOT IN.
C---- TOO BAD ABOUT THAT.

40    REAT=GRAIN*REATR
      IF(REAT.GT.32700.0)REAT=32700.0
      GRAIN=GRAIN-REAT
      IREAT=REAT
23      IF(RAND0-31000)32,41,41

C---- A CRISIS HITS THE PEOPLE! THE KING IS KIDNAPPED.

41      WRITE(1,1013)
1013  FORMAT(' THE KING HAS BEEN KIDNAPPED!')
39      WRITE(1,1014)
1014  FORMAT(' HOW MANY BUSHELLS RANSOM WILL WE PAY?  ')
      READ(1,ERR=39)ICN
      RANSOM=ICN
      IF(RANSOM-GRAIN)38,38,42
42      IWARN=IWARN+1
      WRITE(1,104)
      GO TO 39
38      IF(RANSOM-GRAIN*RANRATE)43,43,24

C---- NOT ENOUGH. SLIT HIS THROAT!

43      WRITE(1,1015)
1015  FORMAT(' IT WAS NOT ENOUGH. THE KING IS NO MORE.')
      GO TO 1
24      WRITE(1,1016)
1016  FORMAT(' THE KING HAS BEEN RELEASED.')
      GRAIN=GRAIN-RANSOM
32      IF(NOFEED-4)2,44,44

C---- AN UPRISING MUST BE AVERTED. MORE FOOD IS THE WAY.

44      WRITE(1,1017)
1017  FORMAT(' THE PEASANTS ARE THREATENING TO REVOLT IF YOU DONT'/
     1 ' GIVE THEM MORE FOOD. HOW MUCH WILL YOU GIVE THEM? ')
35      READ(1,ERR=44)ICN
      GRNT=ICN
      NOFEED=0
      FLOAT=IPOP*MOD(RAND0,5)
      IF(GRNT-FLOAT)33,45,45
45      IF(GRNT-GRAIN)34,34,46
46      IWARN=IWARN+1
      WRITE(1,104)
      WRITE(1,1018)
1018  FORMAT(' HOW MUCH MORE WILL YOU GIVE THE PEASANTS? ')
      GO TO 35

C---- THE RESULTS DEPEND ON THE MANAGER'S GENEROSITY.

34      WRITE(1,1019)
1019  FORMAT(' THEY ACCEPTED YOUR OFFER.')
      GRAIN=GRAIN-GRNT
      GO TO 2
33      WRITE(1,1020)
1020  FORMAT(' YOUR MEASLY OFFER ANGERED THE PEASANTS,'/
     1 ' SO THEY RAIDED THE GRAIN STORES.')
      IWARN=IWARN+1
      GRAIN=GRAIN/2.0
      GO TO 2

C---- HERE ENDS ALL VICTIMS EVENTUALLY.

510      WRITE(1,1021)(INAME(I),I=1,16)
1021  FORMAT(/1X,16A1/' YOUR MANAGEMENT WAS LOUSY.'/)
      IWARN=(RAND0.AND.3)+1
      GO TO (511,512,513,514),IWARN
511     WRITE(1,1022)
1022  FORMAT(' YOU HAVE FLED THE COUNTRY .')
      GO TO 1030
512     WRITE(1,1023)
1023  FORMAT(' YOU HAVE BEEN HUNG!')
      GO TO 1030
513     WRITE(1,1024)
1024  FORMAT(' YOU TOO ARE NOW A PEASANT.')
      GO TO 1030
514     WRITE(1,1025)
1025  FORMAT(' YOU NOW RESIDE IN THE DUNGEONS.')
      GO TO 1030
1030  WRITE(1,1031)
1031  FORMAT(///' ANOTHER SUCKER FOR THE FINK(YES OR NO)?....')
      READ(1)STRING(INAME,1)
      IF(INAME(1).EQ.'Y')GO TO 1
      STOP
      END


